home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / fgfdemo.zip / FGFDEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1992-05-28  |  18KB  |  647 lines
  1. {*****************************************************************************
  2. *                                                                            *
  3. *  FGFDEMO.PAS                                                               *
  4. *                                                                            *
  5. *  This program demonstrates some features of Fastgraph/Fonts version 1.00.  *
  6. *                                                                            *
  7. *  Fastgraph/Fonts lets you easily add bit-mapped font support to Fastgraph  *
  8. *  or Fastgraph/Light applications.                                          *
  9. *                                                                            *
  10. *  Copyright (c) 1992 Ted Gruber Software.  All Rights Reserved.             *
  11. *                                                                            *
  12. *                                                                            *
  13. *  Ted Gruber Software would like to acknowledge the contributions made by   *
  14. *  Randall Dryburgh of Micron Software Sciences in creating FGFDEMO.  Randy  *
  15. *  developed the original versions of the functions relating to the palette  *
  16. *  fades and the digital odometer.                                           *
  17. *                                                                            *
  18. *****************************************************************************}
  19.  
  20. {$M 16384,0,16384}
  21.  
  22. program main;
  23. uses fgtp, fgf;
  24.  
  25. const
  26.  
  27.   NFONTS = 11;
  28.   NPALETTES = 16;
  29.   NSTEPS = 32;
  30.  
  31.   LEFT   = -1;
  32.   CENTER =  0;
  33.   RIGHT  =  1;
  34.   TOP    =  1;
  35.   BOTTOM = -1;
  36.  
  37.   { font names }
  38.  
  39.   fontname : array [1..NFONTS] of string = (
  40.     'Austin 36',
  41.     'Broadway 18',
  42.     'Cognac 19',
  43.     'Crystal 14',
  44.     'Crystal 26',
  45.     'Fountain 27',
  46.     'Modern 28',
  47.     'Plaza 14',
  48.     'Regal 24',
  49.     'Royal 15',
  50.     'Standard 8');
  51.  
  52. var
  53.  
  54.   { font handles }
  55.  
  56.   austin, broadway, cognac, crystal14, crystal26, fountain, modern : integer;
  57.   plaza, regal, royal, standard : integer;
  58.  
  59.   { other globals }
  60.  
  61.   clockspeed : longint;
  62.  
  63.   default_palette, new_palette, zeroes : array [1..NPALETTES*3] of shortint;
  64.   average : array [1..NPALETTES*3] of real;
  65.  
  66. {*****************************************************************************
  67. *                                                                            *
  68. *  average_palette                                                           *
  69. *                                                                            *
  70. *  Compute the palette fade increments used by fade_in and fade_out.         *
  71. *                                                                            *
  72. *****************************************************************************}
  73.  
  74. procedure average_palette;
  75.  
  76. var
  77.  
  78.   i : integer;
  79.  
  80. begin
  81.  
  82.   for i := 1 to NPALETTES*3 do
  83.     average[i] := default_palette[i] / NSTEPS;
  84.  
  85. end;
  86.  
  87. {*****************************************************************************
  88. *                                                                            *
  89. *  fade_in                                                                   *
  90. *                                                                            *
  91. *  Fade one or more DACs from black to their target colors.                  *
  92. *                                                                            *
  93. *****************************************************************************}
  94.  
  95. procedure fade_in (start, count : integer);
  96.  
  97. var
  98.  
  99.   i, j, k, n : integer;
  100.   last : integer;
  101.   factor : real;
  102.  
  103. begin
  104.  
  105.   last := start + count;
  106.  
  107.   for i := 1 to NSTEPS do
  108.   begin
  109.     factor := i;
  110.     k := 0;
  111.     n := start * 3;
  112.     for j := start to last do
  113.     begin
  114.       new_palette[k] := trunc(average[n] * factor);
  115.       inc(k); inc(n);
  116.       new_palette[k] := trunc(average[n] * factor);
  117.       inc(k); inc(n);
  118.       new_palette[k] := trunc(average[n] * factor);
  119.       inc(k); inc(n);
  120.     end;
  121.     fg_setdacs(start,count,new_palette);
  122.     fg_waitfor(1);
  123.   end;
  124.  
  125. end;
  126.  
  127. {*****************************************************************************
  128. *                                                                            *
  129. *  fade_out                                                                  *
  130. *                                                                            *
  131. *  Fade one or more DACs from their current colors to black.                 *
  132. *                                                                            *
  133. *****************************************************************************}
  134.  
  135. procedure fade_out (start, count : integer);
  136.  
  137.  
  138. var
  139.  
  140.   i, j, k, n : integer;
  141.   last : integer;
  142.   factor : real;
  143.  
  144. begin
  145.  
  146.   last := start + count;
  147.  
  148.   for i := 1 to NSTEPS do
  149.   begin
  150.     factor := i;
  151.     k := 0;
  152.     n := start * 3;
  153.     for j := start to last do
  154.     begin
  155.       new_palette[k] := default_palette[n] - trunc(average[n] * factor);
  156.       inc(k); inc(n);
  157.       new_palette[k] := default_palette[n] - trunc(average[n] * factor);
  158.       inc(k); inc(n);
  159.       new_palette[k] := default_palette[n] - trunc(average[n] * factor);
  160.       inc(k); inc(n);
  161.     end;
  162.     fg_setdacs(start,count,new_palette);
  163.     fg_waitfor(1);
  164.   end;
  165.  
  166. end;
  167.  
  168. {*****************************************************************************
  169. *                                                                            *
  170. *  widest_numeral                                                            *
  171. *                                                                            *
  172. *  Compute the width of the widest digit in the current font.                *
  173. *                                                                            *
  174. *****************************************************************************}
  175.  
  176. function widest_numeral : integer;
  177.  
  178. var
  179.  
  180.   widest, width : integer;
  181.   c : integer;
  182.  
  183. begin
  184.  
  185.   widest := 0;
  186.   for c := ord('0') to ord('9') do
  187.   begin
  188.     width := fgf_width(chr(c),1);
  189.     if (width > widest) then widest := width;
  190.   end;
  191.  
  192.   widest_numeral := width;
  193.  
  194. end;
  195.  
  196. {*****************************************************************************
  197. *                                                                            *
  198. *  odometer                                                                  *
  199. *                                                                            *
  200. *  Increment the odometer amount by one cent and scroll its new amount on    *
  201. *  the screen.                                                               *
  202. *                                                                            *
  203. *****************************************************************************}
  204.  
  205. procedure odometer (x, y : integer; amount : real;
  206.                     foreground_color, background_color : integer);
  207.  
  208. var
  209.  
  210.   i, j : integer;
  211.   char_width : integer;
  212.   delay_diff, delay_same : integer;
  213.   height, width : integer;
  214.   length_old, length_new : integer;
  215.   xpos : integer;
  216.   amount_old, amount_new : string[8];
  217.  
  218. begin
  219.  
  220.   { create strings for old and new amounts }
  221.  
  222.   str(amount:7:2,amount_old);
  223.   str(amount+0.01:7:2,amount_new);
  224.   length_old := length(amount_old);
  225.   length_new := length(amount_new);
  226.  
  227.   { get height of the amount string }
  228.  
  229.   height := fgf_height(amount_old,length_old);
  230.  
  231.   { get its width, rounded up to a byte boundary multiple }
  232.  
  233.   width := (widest_numeral + 7) and $FFF8;
  234.  
  235.   { create a box in the background color }
  236.  
  237.   fg_setpage(1);
  238.   fg_setcolor(background_color);
  239.   fg_rect(200,200+width*length_new,100-height,100+height);
  240.   fg_setcolor(foreground_color);
  241.   fgf_justify(LEFT,BOTTOM);
  242.  
  243.   { put old amount on hidden video page }
  244.  
  245.   for i := 1 to length_old do
  246.   begin
  247.     char_width := (width - fgf_width(amount_old[i],1)) div 2;
  248.     fg_move(200+(i-1)*width+char_width,100);
  249.     fgf_print(amount_old[i],1);
  250.   end;
  251.  
  252.   { put new amount on hidden video page }
  253.  
  254.   for i := 1 to length_new do
  255.   begin
  256.     char_width := (width - fgf_width(amount_new[i],1)) div 2;
  257.     fg_move(200+(i-1)*width+char_width,100+height);
  258.     fgf_print(amount_new[i],1);
  259.   end;
  260.  
  261.   { copy old amount to visual video page }
  262.  
  263.   fg_transfer(200,200+width*length_old,100-height,100,x,y,1,0);
  264.  
  265.   { roll the odometer }
  266.  
  267.   delay_diff := (clockspeed div 60) div length_new;
  268.   delay_same := (clockspeed div 10) div length_new;
  269.  
  270.   for j := 1 to height do
  271.   begin
  272.     for i := 1 to length_new do
  273.     begin
  274.       if (amount_new[i] <> amount_old[i]) and (amount_old[i] <> '.') then
  275.       begin
  276.         fg_stall(delay_diff);
  277.         xpos := 200 + (i-1) * width;
  278.         fg_transfer(xpos,xpos+width,100+(j-1)-height,100+(j-1),x+xpos-200,y,1,0);
  279.       end
  280.       else
  281.         fg_stall(delay_same);
  282.     end;
  283.   end;
  284.  
  285. end;
  286.  
  287. {*****************************************************************************
  288. *                                                                            *
  289. *  main program                                                              *
  290. *                                                                            *
  291. *****************************************************************************}
  292.  
  293. var
  294.  
  295.   i : integer;
  296.   abort : boolean;
  297.   old_mode : integer;
  298.   status : integer;
  299.   width : integer;
  300.   x, y : integer;
  301.   amount : real;
  302.   key, aux : byte;
  303.   cc : string[1];
  304.   message : string[24];
  305.  
  306. begin
  307.  
  308.   { make sure we're running on a VGA system; exit if not }
  309.  
  310.   if (fg_testmode(18,0) = 0) then
  311.   begin
  312.     writeln('This demo requires 640 x 480 16 color VGA graphics.');
  313.     exit;
  314.   end;
  315.  
  316.   { load the font files }
  317.  
  318.   austin    := fgf_load('AUSTIN36.FGF'+chr(0));
  319.   broadway  := fgf_load('BRODWY18.FGF'+chr(0));
  320.   cognac    := fgf_load('COGNAC19.FGF'+chr(0));
  321.   crystal14 := fgf_load('CRYSTL14.FGF'+chr(0));
  322.   crystal26 := fgf_load('CRYSTL26.FGF'+chr(0));
  323.   fountain  := fgf_load('FOUNTN27.FGF'+chr(0));
  324.   modern    := fgf_load('MODERN28.FGF'+chr(0));
  325.   plaza     := fgf_load('PLAZA14.FGF'+chr(0));
  326.   regal     := fgf_load('REGAL24.FGF'+chr(0));
  327.   royal     := fgf_load('ROYAL15.FGF'+chr(0));
  328.   standard  := fgf_load('STNDRD08.FGF'+chr(0));
  329.  
  330.   { verify all fonts were loaded successfully; exit if not }
  331.  
  332.   abort := false;
  333.   if (austin = 0) then abort := true;
  334.   if (broadway = 0) then abort := true;
  335.   if (cognac = 0) then abort := true;
  336.   if (crystal14 = 0) then abort := true;
  337.   if (crystal26 = 0) then abort := true;
  338.   if (fountain = 0) then abort := true;
  339.   if (modern = 0) then abort := true;
  340.   if (plaza = 0) then abort := true;
  341.   if (regal = 0) then abort := true;
  342.   if (royal = 0) then abort := true;
  343.   if (standard = 0) then abort := true;
  344.   if (abort) then
  345.   begin
  346.      writeln('Failure loading one or more font files.');
  347.      exit;
  348.   end;
  349.  
  350.   { benchmark the system speed }
  351.  
  352.   clockspeed := fg_measure;
  353.  
  354.   { initialize the array that zeroes the DAC values }
  355.  
  356.   for i := 1 to NPALETTES*3 do
  357.     zeroes[i] := 0;
  358.  
  359.   { initialize Fastgraph's video environment }
  360.  
  361.   old_mode := fg_getmode;
  362.   fg_setmode(18);
  363.   fg_getdacs(0,NPALETTES,default_palette);
  364.  
  365.   { create palette increment averages }
  366.  
  367.   average_palette;
  368.  
  369.   { draw the TGS logo on the hidden page }
  370.  
  371.   fg_setpage(1);
  372.   status := fg_disppcx('TGS.PCX'+chr(0),0);
  373.  
  374.   { fade in the TGS logo on the visual page }
  375.  
  376.   fg_setdacs(0,NPALETTES,zeroes);
  377.   fg_transfer(0,185,0,89,227,285,1,0);
  378.   fade_in(0,16);
  379.  
  380.   { fade in "and" }
  381.  
  382.   fg_setpage(0);
  383.   fg_setrgb(15,0,0,0);
  384.   fgf_select(standard);
  385.   fg_setcolor(15);
  386.   fg_move(320,315);
  387.   fgf_justify(CENTER,CENTER);
  388.   fgf_print('and',3);
  389.   fade_in(15,1);
  390.  
  391.   { fade out the visual page }
  392.  
  393.   fg_waitfor(30);
  394.   fade_out(0,16);
  395.  
  396.   { erase both pages }
  397.  
  398.   fg_setpage(0);
  399.   fg_erase;
  400.   fg_setpage(1);
  401.   fg_erase;
  402.  
  403.   { draw the Micron logo on the hidden page }
  404.  
  405.   fg_move(0,0);
  406.   status := fg_disppcx('MICRON.PCX'+chr(0),0);
  407.  
  408.   { fade in the Micron logo on the visual page }
  409.  
  410.   fg_setdacs(0,NPALETTES,zeroes);
  411.   fg_transfer(0,165,0,52,237,266,1,0);
  412.   fade_in(0,16);
  413.  
  414.   { fade in "present" }
  415.  
  416.   fg_setpage(0);
  417.   fg_setrgb(14,0,0,0);
  418.   fg_setcolor(14);
  419.   fg_move(320,315);
  420.   fgf_print('present',7);
  421.   fade_in(14,1);
  422.  
  423.   { fade to black }
  424.  
  425.   fg_waitfor(30);
  426.   fade_out(0,16);
  427.  
  428.   { erase both pages }
  429.  
  430.   fg_setpage(0);
  431.   fg_erase;
  432.   fg_setpage(1);
  433.   fg_erase;
  434.  
  435.   { display and then fade out the Fastgraph/Fonts logo }
  436.  
  437.   fg_setpage(0);
  438.   fgf_select(austin);
  439.   fg_setcolor(10);
  440.   fg_move(320,240);
  441.   fgf_justify(CENTER,BOTTOM);
  442.   fgf_print('Fastgraph/Fonts',15);
  443.   fgf_select(crystal14);
  444.   fg_setcolor(15);
  445.   fg_move(320,270);
  446.   fgf_justify(CENTER,CENTER);
  447.   fgf_print('Copyright (c) 1992 Ted Gruber Software',38);
  448.   fg_move(320,286);
  449.   fgf_print('All Rights Reserved.',20);
  450.   fade_in(10,1);
  451.   fg_waitfor(18);
  452.   fade_in(15,1);
  453.   fg_waitfor(30);
  454.   fade_out(0,16);
  455.  
  456.   { display the info screen }
  457.  
  458.   fg_setpage(0);
  459.   fg_erase;
  460.  
  461.   fgf_select(regal);
  462.   fg_setcolor(10);
  463.   fg_box(0,639,0,479);
  464.   fg_move(0,32);
  465.   fg_draw(639,32);
  466.   fg_move(320,5);
  467.   fgf_justify(CENTER,TOP);
  468.   fgf_print('Fastgraph/Fonts',15);
  469.  
  470.   fgf_select(modern);
  471.   fg_setcolor(12);
  472.   fg_move(320,60);
  473.   fgf_justify(CENTER,CENTER);
  474.   fgf_print('Fastgraph/Fonts'+chr(127)+chr(9)+' lets you easily add bit-mapped',48);
  475.   fg_move(320,90);
  476.   fgf_print('character support to Fastgraph applications.  It',48);
  477.   fg_move(320,120);
  478.   fgf_print('includes a wide range of fonts in several point sizes.',54);
  479.   fg_move(320,150);
  480.   fgf_print('An application can load up to 32 fonts at once.',47);
  481.  
  482.   fgf_select(broadway);
  483.   fg_setcolor(12);
  484.   fg_move(320,190);
  485.   fgf_print('Fastgraph/Fonts'+chr(127)+chr(15)+' includes functions for font loading',53);
  486.   fg_move(320,215);
  487.   fgf_print('and unloading, string display with horizontal and',49);
  488.   fg_move(320,240);
  489.   fgf_print('vertical justification, font selection, determining',51);
  490.   fg_move(320,265);
  491.   fgf_print('string height and width, and other useful features.',51);
  492.   fg_move(320,290);
  493.   fgf_print('Font files that come with Fastgraph/Fonts may be',48);
  494.   fg_move(320,315);
  495.   fgf_print('distributed freely as part of your applications.',48);
  496.  
  497.   fgf_select(fountain);
  498.   fg_setcolor(9);
  499.   fg_move(320,355);
  500.   fgf_print('The '+chr(127)+chr(12)+'Fastgraph/Fonts User''s Guide'+chr(127)+chr(9)+' includes a',47);
  501.   fg_move(320,385);
  502.   fgf_print('description of the font file format, so you can',47);
  503.   fg_move(320,415);
  504.   fgf_print('create your own font files in case Fastgraph/Fonts',50);
  505.   fg_move(320,445);
  506.   fgf_print('doesn''t include your favorite fonts.',36);
  507.  
  508.   fade_in(0,16);
  509.   fg_waitkey;
  510.   fade_out(0,16);
  511.   fg_erase;
  512.  
  513.   { display the features screen }
  514.  
  515.   fgf_select(cognac);
  516.   fg_setcolor(14);
  517.   fg_move(320,240);
  518.   fgf_print('...and now to demonstrate some Fastgraph/Fonts features...',58);
  519.   fade_in(14,1);
  520.   fg_waitfor(30);
  521.   fade_out(14,1);
  522.   fg_setcolor(1);
  523.   fg_setpage(1);
  524.   fg_rect(0,639,0,319);
  525.   fg_setpage(0);
  526.   fg_rect(0,639,0,479);
  527.   fg_setdacs(0,NPALETTES,default_palette);
  528.  
  529.   fgf_select(crystal26);
  530.   fg_setcolor(15);
  531.   fg_move(320,50);
  532.   fgf_justify(CENTER,BOTTOM);
  533.   fgf_print('Load up to 32 fonts at once!',28);
  534.  
  535.   fgf_select(crystal26);
  536.   fg_setcolor(4);
  537.   fg_move(240,90);
  538.   fgf_print('Jackpot is $ ',13);
  539.   x := fg_getxpos;
  540.   y := fg_getypos;
  541.  
  542.   fgf_select(broadway);
  543.   fg_setcolor(2);
  544.   fg_move(320,120);
  545.   cc := chr(127);
  546.   fgf_print('Change '+cc+chr(3)+'colors '+cc+chr(4)+'anywhere '+cc+chr(5)+'in '+cc+chr(6)+'a '+cc+chr(7)+'string',44);
  547.  
  548.   fgf_select(royal);
  549.   fg_setcolor(14);
  550.   fg_move(320,160);
  551.   fgf_print('Justify strings horizontally and vertically:',44);
  552.   fg_setcolor(7);
  553.   fg_move(0,180);
  554.   fg_dash(639,180,$1111);
  555.   fg_setcolor(14);
  556.   fg_move(0,180);
  557.   fgf_justify(LEFT,BOTTOM);
  558.   fgf_print('LEFT AND ABOVE',14);
  559.   fg_move(320,180);
  560.   fgf_justify(CENTER,CENTER);
  561.   fgf_print('CENTERED BOTH DIRECTIONS',24);
  562.   fg_move(639,180);
  563.   fgf_justify(RIGHT,TOP);
  564.   fgf_print('RIGHT AND BELOW',15);
  565.  
  566.   fgf_select(modern);
  567.   fg_setcolor(12);
  568.   fg_move(320,220);
  569.   width := fgf_width(' ',1);
  570.   fgf_space(width div 2);
  571.   fgf_justify(CENTER,CENTER);
  572.   fgf_print('narrow spacing between words',28);
  573.   fg_move(320,250);
  574.   fgf_space(width);
  575.   fgf_print('normal spacing between words',28);
  576.   fg_move(320,280);
  577.   fgf_space(width*2);
  578.   fgf_print('wide spacing between words',26);
  579.  
  580.   repeat
  581.      fg_intkey(key,aux);
  582.   until (key+aux = 0);
  583.  
  584.   fgf_select(crystal26);
  585.   fg_setcolor(4);
  586.   amount := 1998.31;
  587.   repeat
  588.   begin
  589.     odometer(x,y,amount,4,1);
  590.     amount := amount + 0.01;
  591.     fg_intkey(key,aux);
  592.   end;
  593.   until (key+aux > 0) or (amount >= 10000.00);
  594.  
  595.   { cast of characters screen }
  596.  
  597.   fg_setpage(0);
  598.   fg_erase;
  599.   fgf_select(regal);
  600.   fg_setcolor(10);
  601.   fg_move(320,0);
  602.   fgf_justify(CENTER,TOP);
  603.   fgf_print('*** Partial Cast of Characters ***',34);
  604.  
  605.   message := 'ABCDabcd1234.,?!+-&@#$';
  606.   y := 80;
  607.  
  608.   for i := 1 to NFONTS do
  609.   begin
  610.     fgf_select(i);
  611.     fg_setcolor(i);
  612.     fg_move(20,y);
  613.     fgf_justify(LEFT,BOTTOM);
  614.     fgf_print(fontname[i],length(fontname[i]));
  615.     fg_move(620,y);
  616.     fgf_justify(RIGHT,BOTTOM);
  617.     fgf_print(message,22);
  618.     y := y + 36;
  619.   end;
  620.  
  621.   fg_setcolor(10);
  622.   fg_move(320,y);
  623.   fgf_justify(CENTER,BOTTOM);
  624.   fgf_print('and many more!',14);
  625.  
  626.   fg_waitkey;
  627.   fade_out(0,16);
  628.  
  629.   { unload fonts and restore the original video state before exiting }
  630.  
  631.   fgf_unload(-1);
  632.   fg_setmode(old_mode);
  633.   fg_reset;
  634.  
  635.   { display ordering information }
  636.  
  637.   writeln('Fastgraph/Fonts (tm) is available for $49 from:');
  638.   writeln;
  639.   writeln('Ted Gruber Software     orders/info (702) 735-1980');
  640.   writeln('PO Box 13408                    FAX (702) 735-4603');
  641.   writeln('Las Vegas, NV  89112            BBS (702) 796-7134');
  642.   writeln;
  643.   writeln('Please add $3 shipping within the U.S. and Canada,');
  644.   writeln('or $6 to other countries.');
  645.  
  646. end.
  647.